home *** CD-ROM | disk | FTP | other *** search
/ Input 64 / Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64 / tracer .lsp < prev   
Text File  |  2023-02-26  |  2KB  |  52 lines
  1. (trace fexpr (nlambda l (setq 
  2. trace-spaces 0) (no-single-step) (
  3. mapc (quote (lambda (func) (prog (x) (
  4. setq x (or (getprop func (quote expr))
  5.  (getprop func (quote fexpr)) (
  6. getprop func (quote macro)) nil)) (
  7. cond ((null x) (return nil))) (rplacd 
  8. (cdr x) (list (list (quote evtrace) 
  9. func (cadr x) (cddr x))))))) l) l))
  10. (untrace fexpr (nlambda l (setq 
  11. trace-spaces 0) (mapc (quote (lambda (
  12. func) (prog (x) (setq x (or (getprop 
  13. func (quote expr)) (getprop func (
  14. quote fexpr)) (getprop func (quote 
  15. macro)) nil)) (cond ((null x) (return 
  16. nil))) (rplacd (cdr x) (last (last x))
  17. )))) l) l))
  18. (evtrace fexpr (nlambda (trfun trvars 
  19. trbody) (prog (trresult) (printentry 
  20. trfun trvars) (setq trresult (apply (
  21. quote progn) trbody)) (printexit 
  22. trfun trresult) (return trresult))))
  23. (printentry expr (lambda (trfun 
  24. trvars) (spaces (setq trace-spaces (
  25. add1 trace-spaces))) (msg "entering " 
  26. trfun " [") (printentry1 trvars) (msg 
  27. "]" t) (cond (single-step-v (waitchar)
  28. ))))
  29. (printentry1 expr (lambda (trvars) (
  30. cond ((null trvars) nil) ((atom 
  31. trvars) (prin1 (eval trvars))) ((atom 
  32. (cdr trvars)) (prin1 (eval (car 
  33. trvars)))) (t (prin1 (eval (car 
  34. trvars))) (msg ",") (printentry1 (cdr 
  35. trvars))))))
  36. (printexit expr (lambda (trfun 
  37. trresult) (spaces (setq trace-spaces (
  38. sub1 trace-spaces))) (msg 
  39. " exiting  " trfun " = ") (print 
  40. trresult) (cond (single-step-v (
  41. waitchar)))))
  42. (single-step expr (lambda nil (setq 
  43. single-step-v t)))
  44. (no-single-step expr (lambda nil (
  45. setq single-step-v nil)))
  46. (single-step-v value nil)
  47. (tracfns value (trace untrace evtrace 
  48. printentry printentry1 printexit 
  49. single-step no-single-step 
  50. single-step-v tracfns))
  51. nil
  52.